home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok70.lha / PL0 / txt / PL0Scanner.mod < prev    next >
Text File  |  1993-08-15  |  6KB  |  270 lines
  1. (*************************************************************************
  2.  
  3. :Program.       PL0Scanner.mod
  4. :Contents.      Text-Scanner for PL0-Complier
  5. :Author.        N. With, ported to Oberon by hartmut Goebel
  6. :Language.      Oberon
  7. :Translator.    Amiga Oberon
  8.  
  9. :Imports.       TextWindows (hartmut Goebel)
  10.  
  11. *************************************************************************)
  12.  
  13. MODULE PL0Scanner;
  14.  
  15. IMPORT
  16.   fs: FileSystem, NoGuru,
  17.   sys: SYSTEM,
  18.   str: Strings,
  19.   tw: TextWindows;
  20.  
  21. CONST
  22.   (* Symbol *)
  23.   null* = 0;    odd* = 1;    times* = 2;      div* = 3;      plus* = 4;
  24.   minus* = 5;   eql* = 6;    neq* = 7;        lss* = 8;      leq* = 9;
  25.   gtr* = 10;    geq* = 11;   comma* = 12;     rparen* = 13;
  26.   then* = 14;   do* = 15;    lparen* = 16;    becomes* = 17;
  27.   number* = 18; ident* = 19; semicolon* = 20; end* = 21;
  28.   call* = 22;   if* = 23;    while* = 24;     begin* = 25;
  29.   read* = 26;   write* = 27; const* = 28;     var* = 29;
  30.   procedure* = 30;           period* = 31;    eof* = 32;
  31.  
  32. VAR
  33.   sym*: INTEGER; (* last Symbol read *)
  34.   id*:  INTEGER; (* character Buffer Index *)
  35.   num*: INTEGER; (* last number read *)
  36.   source*: fs.File;
  37.  
  38. TYPE
  39.   keyTable = ARRAY 20 OF
  40.                RECORD sym: INTEGER; ind: INTEGER; END;
  41. CONST
  42.   maxCard = MAX(INTEGER);
  43.   bufLen = 1000;
  44.  
  45. VAR
  46.   keyTab: ARRAY 20 OF
  47.             RECORD sym: INTEGER; ind: INTEGER; END;
  48. VAR
  49.   ch: ARRAY 1 OF CHAR; (* last character read *)
  50.   id0, id1: INTEGER;   (* indices to identifier Buffer *)
  51.   win: tw.TxtWinPtr;
  52.   K: INTEGER; (* no of key words *)
  53.   buf*: ARRAY bufLen OF CHAR;
  54.     (* charkter buffer:
  55.        identifiers are stored with leading length count *)
  56.  
  57. PROCEDURE Mark*(n: INTEGER);
  58. BEGIN
  59.   tw.Inversid(win);
  60.   tw.WriteInt(win,n,3);
  61.   tw.Normal(win);
  62. END Mark;
  63.  
  64.  
  65. PROCEDURE GetCh;
  66. BEGIN
  67.   IF fs.ReadChar(source,ch[0]) THEN
  68.     IF ch >=" " THEN
  69.       tw.WriteString(win,ch);
  70.     ELSE
  71.       tw.WriteLn(win);
  72.     END;
  73.   ELSE
  74.     ch[0] := 0X;
  75.   END;
  76. END GetCh;
  77.  
  78.  
  79. PROCEDURE Diff*(u,v: INTEGER): INTEGER;
  80.   (* difference between identifier at buf[u] and buf[v] *)
  81. VAR
  82.   w: INTEGER;
  83. BEGIN
  84.   w := ORD(buf[u]);
  85.   LOOP
  86.     IF w = 0 THEN RETURN 0;
  87.     ELSIF buf[u] # buf[v] THEN
  88.       RETURN ORD(buf[u])-ORD(buf[v]);
  89.     ELSE
  90.       DEC(w); INC(u); INC(v);
  91.     END;
  92.   END;
  93. END Diff;
  94.  
  95.  
  96. PROCEDURE KeepId*;
  97. BEGIN id := id1 END KeepId;
  98.  
  99.  
  100. PROCEDURE Identifier;
  101. VAR
  102.   k, l, m, d: INTEGER;
  103. BEGIN
  104.   id1 := id;
  105.   IF id1 < bufLen THEN INC(id1) END;
  106.   REPEAT
  107.     IF id1 < bufLen THEN
  108.       buf[id1] := ch[0]; INC(id1); END;
  109.       GetCh;
  110.   UNTIL (ch[0]<"0") OR (ch[0]>"9") & (CAP(ch[0])<"A") OR (CAP(ch[0])>"Z");
  111.   buf[id] := CHR(id1-id); (* Length *)
  112.   k := 0;
  113. (*l := K; REPEAT
  114.     m := (k+l) DIV 2; d := Diff(id,keyTab[m].ind);
  115.     IF d <= 0 THEN l := m-1; END;
  116.     IF d >= 0 THEN k := m+1; END;
  117.   UNTIL k>l;
  118.   IF k > l+1 THEN sym := keyTab[m].sym;
  119.   ELSE sym := ident; END;
  120. *)
  121.   sym := ident;
  122.   REPEAT
  123.     IF Diff(id,keyTab[k].ind) = 0 THEN
  124.       sym := keyTab[k].sym;
  125.       RETURN;
  126.     END;
  127.     INC(k);
  128.   UNTIL k=K;
  129. END Identifier;
  130.  
  131.  
  132. PROCEDURE Number;
  133. VAR
  134.   i, j, k, d: INTEGER;
  135.   dig: ARRAY 32 OF CHAR;
  136. BEGIN
  137.   i := 0; sym := number;
  138.   REPEAT
  139.     dig[i] := ch[0]; INC(i); GetCh;
  140.   UNTIL (ch[0]<"0") OR (ch[0]>"9") & (CAP(ch[0])<"A") OR (CAP(ch[0])>"Z");
  141.   j := 0; k := 0;
  142.   REPEAT
  143.     d := ORD(dig[j])-ORD("0");
  144.     IF (d < 10) & ((maxCard-d) DIV 10 >= k) THEN
  145.       k := 10*k+d;
  146.     ELSE
  147.       Mark(30); k := 0;
  148.     END;
  149.     INC(j);
  150.   UNTIL j=i;
  151.   num := k;
  152. END Number;
  153.  
  154.  
  155. PROCEDURE GetSym*;
  156. VAR
  157.   xch: ARRAY 1 OF CHAR;
  158.  
  159.   PROCEDURE Comment;
  160.   BEGIN
  161.     GetCh;
  162.     REPEAT
  163.       WHILE ch[0] # "*" DO GetCh; END;
  164.       GetCh;
  165.     UNTIL ch[0] = ")";
  166.     GetCh;
  167.   END Comment;
  168.  
  169. BEGIN
  170.   LOOP (* ignore control characters *)
  171.     IF ch[0] <= " " THEN
  172.       IF ch[0] = 0X THEN EXIT END;
  173.       GetCh;
  174.     ELSIF ch[0] >= 7FX THEN GetCh;
  175.     ELSE EXIT;
  176.     END;
  177.   END;
  178.   CASE ch[0] OF (* " " <= ch[0] <= 7FC *)
  179.     0X : sym := eof; |
  180.     " ": sym := eof; ch[0] := 0X |
  181.     "!": sym := write; GetCh |
  182.     '"': sym := null; GetCh |
  183.     "#": sym := neq; GetCh |
  184.     "$": sym := null; GetCh |
  185.     "%": sym := null; GetCh |
  186.     "&": sym := null; GetCh |
  187.     "'": sym := null; GetCh |
  188.     "(": GetCh;
  189.          IF ch[0] = "*" THEN Comment; GetSym
  190.          ELSE sym := lparen;
  191.          END |
  192.     ")": sym := rparen; GetCh |
  193.     "*": sym := times; GetCh |
  194.     "+": sym := plus; GetCh |
  195.     ",": sym := comma; GetCh |
  196.     "-": sym := minus; GetCh |
  197.     ".": sym := period; GetCh |
  198.     "/": sym := div; GetCh |
  199.     "0".."9": Number |
  200.     ":": GetCh;
  201.          IF ch[0] = "=" THEN GetCh; sym := becomes;
  202.          ELSE sym := null;
  203.          END |
  204.     ";": sym := semicolon; GetCh |
  205.     "=": sym := eql; GetCh |
  206.     "<": GetCh;
  207.          IF ch[0] = "=" THEN GetCh; sym := leq;
  208.          ELSE sym := lss;
  209.          END |
  210.     ">": GetCh;
  211.          IF ch[0] = "=" THEN GetCh; sym := geq;
  212.          ELSE sym := gtr;
  213.          END |
  214.     "?": sym := read; GetCh |
  215.     "@": sym := null; GetCh |
  216.     "A".."Z", "a".."z": Identifier |
  217.     "[".."`": sym := null; GetCh |
  218.     "{".."~": sym := null; GetCh |
  219.   ELSE
  220.   END;
  221. END GetSym;
  222.  
  223.  
  224. PROCEDURE InitScanner*;
  225. BEGIN
  226.   ch[0] := " ";
  227.   IF id0 = 0 THEN id0 := id;
  228.   ELSE id := id0; tw.ClrHome(win); tw.Normal(win);
  229.   END;
  230. END InitScanner;
  231.  
  232.  
  233. PROCEDURE EnterKW(sym: INTEGER; name: ARRAY OF CHAR);
  234. VAR
  235.   l, L: INTEGER;
  236. BEGIN
  237.   keyTab[K].sym := sym;
  238.   keyTab[K].ind := id;
  239.   l := 0; L := str.Length(name);
  240.   buf[id] := CHR(L+1);
  241.   INC(id);
  242.   WHILE l<=L DO
  243.     buf[id] := name[l];
  244.     INC(id); INC(l);
  245.   END;
  246.   INC(K);
  247. END EnterKW;
  248.  
  249.  
  250. BEGIN
  251.   K := 0; id := 0; id0 := 0;
  252.   EnterKW(do,"DO");
  253.   EnterKW(if,"IF");
  254.   EnterKW(end,"END");
  255.   EnterKW(odd,"ODD");
  256.   EnterKW(var,"VAR");
  257.   EnterKW(call,"CALL");
  258.   EnterKW(then,"THEN");
  259.   EnterKW(begin,"BEGIN");
  260.   EnterKW(const,"CONST");
  261.   EnterKW(while,"WHILE");
  262.   EnterKW(procedure,"PROCEDURE");
  263.   win := tw.OpenTextWin("PROGRAMM",0,0,640,100);
  264.   IF (win=NIL) THEN HALT(20); END;
  265.  
  266. CLOSE
  267.   IF win # NIL THEN tw.CloseTextWin(win); END;
  268. END PL0Scanner.
  269.  
  270.